00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. LOAD WITH MSFAIL.FAI
00210		COMMON/STF/RSTFAC(-3/4),RSTJ2 /XXX/LK,LP,JY
00232		COMMON/XRN/RN(2000),XN(2000)
00254		COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
00276		COMMON/POSI/STFF(-3/4),JJ2,PQ/PTR/PWDS(250),L,LL,I,IX
00300	      DIMENSION IV(78),LIST(200),
00400		1XWDS(250)
00500	C**** RN MIGHT HAVE TO BE 4000 ******
00600		COMMON /PX/POS,SX
00605		DATA FIB/.5/
00650		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
00655		1,(R8,RQ(6)),(R9,RQ(7))
00660	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
00700	
00800	14	JT=0
00900		JR=0
01000		REWIND 1
01100	1	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01200		TYPE 1
01300		ACCEPT 2,NAMX
01400	213	IF(LOOKD(NAMX).GE.0)GO TO 13
01500		TYPE 88,NAMX
01600		ACCEPT 2,L
01700		IF(L.EQ.'N')GO TO 14
01800	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
01900	13	CALL OFILE(1,NAMX)
02000		XWDS(1)=1
02010		JRH=-1
02020	C  FOR REST COLLECTION
02100		IF(JT.EQ.0)RM=0
02200		L=1
02210		JX=0
02300		LX=1
02400		LP=1
02410		IF(JT.NE.0)GO TO 87
02500	CJ44	FORMAT(' TYPE TOP OUTPUT STAFF #  ',$)
02600	CJ	TYPE 44
02700	CJ	ACCEPT 5,RS
02750	CJ	RSX=RS
02755		RS=3
02760	C  SAVE UPPER STAFF NUM FOR NEXT FILE.
02770		TYPE 144
02775	144	FORMAT(' STAFF SIZE = '$)
02780		ACCEPT 5,STFSZ
02785	C  NON-ZERO STFSZ WILL CHANGE P5 IN ALL USED STAVES.
02800	10	IF(JT.EQ.0)GO TO 83
02900	87	NAME=NAME+2
03000		GO TO 84
03100	86	FORMAT(1XA5)
03200	3	FORMAT(' TYPE INPUT NAME, (CONT), (NOBAR)  ',$)
03300	83	TYPE 3
03400		ACCEPT 2,NAME,JT,NBAR
03500	C  TYPE ANY NUMBER AFTER NAME AND IT WILL GO TO NEXT LETTER IN ALPH.
03510		NAMZ=NAME
03600		IF(NBAR.NE.0)NBAR=-1
03700	C  ANY THIRD NUM. SUPPRESSES SCORE BARLINE FEATURE
03800	84	LK=LP
03900		IF(LOOKD(NAME))GO TO 284
03910		NAME=NAMZ+256
03920		IF(LOOKD(NAME).GE.0)GO TO 201
03930		NAMZ=NAME
04000	C  FOUND NO MORE TO READ
04100	284	TYPE 86,NAME
04200		JZ=0
04300		IF(RM.NE.0)GO TO 77
04400		RM=-1
04500	4	FORMAT(' TYPE INST NAME, (RESPC?) '$)
04600		TYPE 4
04700		ACCEPT 2,RNAM,NRS
04705	C  TYPE ANY NUM AFTER INS. NAME TO STOP RHYTH RESPACING.
04710		IF(RNAM.GT.0)REREAD 5,SN
04800		IF(INM.EQ.'99')GO TO 20
04900	CC	K=SN/100.
05000		TYPE 46
05100	46	FORMAT(' TRANS. NUM. -- '$)
05200		ACCEPT 5,TR
05202	C  TRANSPOSITION BY STEPS
05300		IF(TR.GE.99)GO TO 83
05400	77	REWIND 21
05500	177	CALL IFILE(21,NAME)
05600		READ(21),ITEM,I,
05700		1 (PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1),ISCR,(IV(K),K=1,ISCR),
05800		1 LCNT,(LIST(K),K=1,LCNT),RSTFAC,STFF
06000		DO 45 K=1,ITEM
06100		J=PWDS(K)
06200		IF(RN(J+1).NE.8)GO TO 45
06210		IF(RNAM)GO TO 145
06220		IF(RN(J+2).EQ.SN)GO TO 8 
06230		GO TO 45
06290	145	R9=RN(J+9)
06295		TYPE 86,R9
06300		IF(R9.NE.RNAM)GO TO 45
06400		SN=RN(J+2)
06410		IF(STFSZ.EQ.0)STFSZ=RSTFAC(IFIX(SN))
06500	C  FOUND THE STAFF
06600		GO TO 8
06700	45	CONTINUE
06800	C??	L=JX
06900	C??	LP=JY
07000		TYPE 16
07100	16	FORMAT(' INST. NOT FOUND'/)
07200		GO TO 10
07250	8	SIG=200
07275	C  FOR TRANSP. SECTION.
07300		DO 6 K=1,ITEM
07400		J=PWDS(K)
07410		R=RN(J+1)
07420		IF(R.NE.10)GO TO 800
07422		IF(RN(J).LT.4)GO TO 80
07424		IF(RN(J+6).GT.1.3)GO TO 6
07426	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
07430		IF(RN(J).LT.6)GO TO 80
07440	C  FOUND A NUM. IN BOX ↓↓
07450		RN(J+2)=SN
07460		GO TO 81
07500	800	IF(R.NE.4)GO TO 80
07600		IF(NBAR)GO TO 80
07700		IF(RN(J).NE.2)GO TO 80
07800	C  FOUND A BAR LINE
07900		KB=RN(J+4)/100.
08000		RN(J+4)=1.+KB*100.
08100	C  KB IS FOR THICK BARS.
08200		R=RN(J+3)
08300		DO 82 KA=K+1,ITEM
08400		KB=PWDS(KA)
08500		IF(RN(KB+1).NE.4)GO TO 82
08600		IF(RN(KB).NE.2)GO TO 82
08700	C  AVOIDS DUPLICATE BARS.
08800		IF(ABS(R-RN(KB+3)).GT..5)GO TO 82	
08900		RN(KB+2)=99
09000		RN(KB+1)=0
09100	82	CONTINUE
09200		GO TO 81
09300	80	IF(RN(J+2).NE.SN)GO TO 6
09400		IF(RN(J+1).NE.8)GO TO 81
09500		IF(RN(J).LT.2)GO TO 81
09510	C  CAN'T CHANGE 0 SIZE TO OTHER YET.
09600		RN(J+4)=0
09700	C  SETS VERT. POS. OF STAFF TO 0.  NEXT IS FOR P5.
09705		IF(RN(J).LT.3)GO TO 81
09710		RN(J+5)=STFSZ
09800	CC85	JZ=-1
09900	81	JA=PWDS(K+1)
10000		DO 7 KA=J,JA-1
10100		XN(LK)=RN(KA)
10200	7	LK=LK+1
10300		IF(L.GE.200)GO TO 150
10400		IF(LK.LE.1700)GO TO 50
10500	150	TYPE 9
10600		GO TO 20
10610	9	FORMAT(' NO ROOM FOR THIS ONE, FILE ENDED.')
10700	50	R=XN(LP+1)
11200		XN(LP+2)=RS
11300		L=L+1
11400		LP=LK
11500		XWDS(L)=LP
11600	6	CONTINUE
11700	17	JX=L
11800		JY=LP
11910		IF(NRS.NE.0)GO TO 200
12000	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
12100		M=LX+1
12200		J=XWDS(LX)
12300		PWDS(LX)=XWDS(LX)
12400		I=LX
12410		DO 243 K=LX,L-1
12420		LB=XWDS(K)+1
12430		IF(XN(LB).NE.16)GO TO 243
12440		IF(XN(LB-1).LT.8)GO TO 243
12445		JL=XWDS(K-1)
12448	244	XN(LB+2)=XN(JL+3)
12450	C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
12455	C  FOR SPACING PROBLEMS BELOW.
12460	243	CONTINUE
12500	24	RA=10000.
12600	C  POSITION
12700		DO 21 K=LX,L-1
12800		JL=XWDS(K)+3
12990		R=XN(JL)
13000		IF(R.EQ.10000)GO TO 21
13020	CC	IF(XN(JL-2).NE.16)GO TO 241
13060	CJ  WILL SORT ONLY NOTES, RESTS, CLEFS, BARS.
13080	CC	I=K
13090	CC	GO TO 242
13100	241	IF(ABS(R-RA).GT..1)GO TO 240
13200		R=RA
13300		XN(JL)=R
13400	C  PUT IN HERE MULTI-VOICE TRAP
13500		GO TO 21
13600	240	IF(R.GT.RA)GO TO 21
13700	C  LINES THEM UP
13800		I=K
13900		RA=R
14000	21	CONTINUE
14100		IF(RA.EQ.10000)GO TO 23
14200	C  JUMP IF ALL SORTED
14300	242	JL=XWDS(I)
14400		LA=JL
14500		N=XN(JL)+3
14600	C  NEXT POINTER
14700		PWDS(M)=PWDS(M-1)+N
14800		M=M+1
14900		DO 22 K=J,J+N-1
15000		RN(K)=XN(JL)
15100	22	JL=JL+1
15200		XN(LA+3)=10000
15300	C  PUT IT ASIDE
15400		J=N+J
15500		GO TO 24
15600	
15610	23	CALL RESTS
15700		LB=LX
15710		JFST=0
15720		POS=0
15740		R5X=0
15770	C  NEXT RECONSTITUTES RHYTHM
15800	25	N=PWDS(LB)
15900		R=RN(N+1)
15910		IF(TR.EQ.0)GO TO 51
15915		IF(R.EQ.1)GO TO 52
15920		IF(R.EQ.5)GO TO 52
15925		IF(R.EQ.6)GO TO 52
15950		IF(R.EQ.17)GO TO 117
16000	51	IF(R.LE.4)GO TO 430
16050		IF(R.LT.17)GO TO 30
16075	C LOOKS FOR 17 AND 18, KSIG AND METER.
16100	430	IF(R.NE.1)GO TO 230
16200		IF(RN(N).LT.7)GO TO 30
16210		IF(RN(N+9))GO TO 30
16220	C SKIPS NON-LEDGER LINE NOTES.
16230		GO TO 530
16300	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
16310	230	IF(R.NE.2)GO TO 330
16320		IF(RN(N).LT.5)GO TO 30
16330	C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
16335	530	IF(JFST.NE.0)GO TO 130
16340		JFST=LB+1
16345		POS=RN(N+3)
16347	C  POS IS LEFTMOST NOTE OR REST
16350		GO TO 130
16360	330	IF(JFST.EQ.0)GO TO 30
16362	C  ONLY LOOKS AT ITEMS AFTER FIRST N0TE OR REST.
16365		IF(R.NE.4)GO TO 130
16382		IF(RN(N).NE.2)GO TO 30
16390	130	IF(RCLEF(RN(N)))GO TO 30
16395	CJ SKIPS NON-CLEFS
16400		S=RN(N+3)
16500		LA=LB
16600	26	LA=LA+1
16700		IF(LA.GE.L)GO TO 30
16800	C  FIND NEXT IMPORTANT ITEM
16900		NA=PWDS(LA)
17000		RR=RN(NA+1)
17100		IF(RR.LE.4)GO TO 134
17150		IF(RR.LT.17)GO TO 26
17200	134	IF(RR.NE.4)GO TO 34
17300		IF(RN(NA).NE.2)GO TO 26
17400	C  USES ONLY NOTES, RESTS, BARS, CLEFS
17450	34	IF(RCLEF(RN(NA)))GO TO 26
17460	CJ SKIPS NON-CLEFS
17500		RX=RN(NA+3)
17600	C  POSITION OF NEXT ITEM
17700		IF(S.EQ.RX)GO TO 26
17800		A=RX-2
17900		IF(A.LT.S)A=S+.5
18000	C  SPACING WILL BEGIN NEARBY
18010		IF(R.LT.3)GO TO 235
18012		IF(R.GE.17)P=4.
18016	C  PUT IN FOR LARGE KSIGS LATER.
18020		IF(R.EQ.4)P=2.
18030		IF(R.EQ.3)P=6.
18040		IF(RN(NA+5).GE.100.)P=5.
18050	C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
18055		IF(RR.EQ.17)P=P+3.
18057	C  IF NEXT(RR) IS KSIG, ADD SPACE.
18060		GO TO 335
18100	235	K=9
18200		IF(R.EQ.2)K=7
18300		P=RN(N+K)
18400		P=P+(.125-P)*FIB
18500	135	P=P*15.
18600	C  FINDS RHYTH IN P9 OR P7(REST)
18700	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
18800		IF(P)GO TO 30
18900	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
19000	335	SX=S+P-RX
19050		R5X=R5X+SX
19100	C  SPACE DIFFERENCE
19200	35	DO 29 K=JFST,L
19300		RR=SX
19400		NZ=PWDS(K)+3
19500		RA=RN(NZ)
19600	
19700		IF(RA.LT.A)RR=RR*(RA-S)/(A-S)
19750		IF(RA.GT.S)RN(NZ)=RA+RR	
19775		RR=SX
19800	C  A=BASIC POS. AT THIS TIME.
19900		R=RN(NZ-2)
20000		IF(R4567(R))GO TO 29
20100		NZ=NZ-3
20200		IF(RN(NZ).EQ.2)GO TO 29
20300		RB=RN(NZ+6)
20400		IF(RB.LT.A)RR=RR*(RB-S)/(A-S)
20500		IF(RB.GT.S)RN(NZ+6)=RB+RR
20600		IF(R.EQ.6)CALL BMQ(RN,NZ,A)
21600	29	CONTINUE
21700	30	LB=LB+1
21800		IF(LB.LT.L)GO TO 25
21810	C  GO BACK IF MORE SPACING TO DO
21815		P8=0
21816		LL=0
21820		IF(XLFT.EQ.0)GO TO 600
21830	C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
21840		R5=POS-.5
21850		R7=RS
21860		R8=-XLFT
21865		R4=-101
21870		R9=0
21880		CALL PTMOVE
21885		R8=POS-XLFT
21890		R4=POS
21925	600	R5=R5X+200
21950	
22000	C  R5 HAS SpACE CHANGE (SEE 35-1)
22020		R9=200
22100		R7=RS
22210		IF(LX.EQ.1)GO TO 300
22220		DO 301 K=IFIX(PWDS(1)),IFIX(PWDS(LX))-1
22230	301	RN(K)=0
22240	C  CLEARS CONFUSION IN MOVER.!!!
22300	300	CALL PTMOVE
22400		RSTFAC(IFIX(RS))=STFSZ
22500		R4=0
22600		R5=200.
22700		LL='J'
22800	400	CALL PTMOVE
22900	C TO JUSTIFY IT.
23000	
24200	500	DO 32 K=IFIX(PWDS(LX)),IFIX(PWDS(L))
24300	32	XN(K)=RN(K)
24400		DO 33 K=LX,L
24410		LL=PWDS(K)
24420		R=XN(LL+1)
24430		RR=XN(LL)
24440		IF(R.NE.2)GO TO 333
24450	C  NEXT FOR RESTS
24460		IF(RR.LT.6)GO TO 33
24470		R=XN(LL+8)
24480		IF(R.LE.0)GO TO 33
24500	C NEXT FOR CENTERING WHOLE REST
24510		R=XN(IFIX(PWDS(K-1))+3)
24515		RR=XN(IFIX(PWDS(K+1))+3)
24520		XN(LL+3)=R+(RR-R)/2.
24530		GO TO 33
24540	333	IF(R.NE.16)GO TO 33
24550		IF(RR.LT.8)GO TO 33
24560		NZ=PWDS(K-1)
24570		IF(XN(NZ+1).NE.16)GO TO 33
24580	C  NEXT FOR CONTINUING TEXT
24590		XN(LL+3)=XN(NZ+3)+XN(NZ+9)*STFSZ*XN(NZ+5)
24650	33	XWDS(K)=PWDS(K)
24675	C  ALL DONE
24700	C****↑↑↑↑↑↑  RHYTH. RESET ↑↑↑↑↑↑↑↑↑↑↑
24710	200	KA=LX
24720		KB=L
24800		LX=L
24900	
24910		RS=RS-1
25000	CJ	IF(RS.GT.-4)GO TO 10
25050		IF(RS.GT.-1)GO TO 10
25100	20	L=JX-1
25200		J=1
25300		WRITE(1),L,JY,
25400		1 (XWDS(K),K=1,L+1),(XN(K),K=1,JY-1),J,J,J,J,RSTFAC,STFF,IV,STFF
25500	C  STUFF ON THE END IS FOR FORTRAN IO BUG.
25510		TYPE 86,NAMX
25600	15	END FILE 1
25700		IF(JT.EQ.0)CALL EXIT
25710		NAMX=NAMX+2
25712		TYPE 86,NAMX
25715	CJ	RS=RSX
25717		RS=3
25720		GO TO 213
25730	201	JT=0
25740		GO TO 20
25800	2	FORMAT(A5,2I)
25900	5	FORMAT(5F)
26100	
26200	
26300	52	A=RN(N+4)
26400		RN(N+4)=A+TR
26500	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
26600		X=RN(N+5)
26700		IF(RN(N+1).EQ.1)GO TO 11
26705	C  COULD ADD STEM REVERSE HERE.
26800		RN(N+5)=X+TR
26900		GO TO 51
26910	11	A=AMOD(A,100.)
27000		IF(TR.NE.4)GO TO 1101
27100		IF(AMOD(A,7.0).EQ.0)GO TO 101
27200	1101	IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
27300	C  NEXT IS FOR Bb TRANSP.
27400		B=AMOD(A+7.0,7.0)
27500		IF(B.EQ.0)GO TO 101
27600		IF(B.NE.3)GO TO 51
27700	C  FINDS ORIG. E OR B
27800	101	M=AMOD(X,10.0)
27900	C  FINDS ACCID.
28000		X=X-M
28100	C  STEM DIR. AND DECI.
28200		B=3.
28300	C CHANGES FLAT TO NATURAL SIGN.
28310		IF(M.NE.0)GO TO 118
28320		IF(SIG.NE.200)GO TO 51
28330	C  GO BACK IF A KEY SIG. IS PRESENT
28400	118	IF(M.EQ.3)B=2
28500	C  NO PROVISION YET FOR ## OR bb
28600	2101	RN(N+5)=X+B
28700		GO TO 51
28710	117	SIG=RN(N+5)
28720		IF(TR.EQ.1)SIG=SIG+2
28730		IF(TR.EQ.4)SIG=SIG+1
28740	C CHANGE KSIG FOR Bb AND F INSTS.  ADD CHECK-UP ABOVE LATER.
28745	C  MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
28747		IF(SIG.NE.0)GO TO 217
28748		IF(TR.EQ.1)SIG=-102
28749		IF(TR.EQ.3)SIG=-101
28750	217	RN(N+5)=SIG
28760		GO TO 51
28800		END